home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / nt / emacssrc.zip / EMACSSRC.TAR / emacs-19.17 / src / bytecode.c < prev    next >
C/C++ Source or Header  |  1993-10-06  |  24KB  |  1,162 lines
  1. /* Execution of byte code produced by bytecomp.el.
  2.    Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. hacked on by jwz@lucid.com 17-jun-91
  21.   o  added a compile-time switch to turn on simple sanity checking;
  22.   o  put back the obsolete byte-codes for error-detection;
  23.   o  added a new instruction, unbind_all, which I will use for 
  24.      tail-recursion elimination;
  25.   o  made temp_output_buffer_show be called with the right number
  26.      of args;
  27.   o  made the new bytecodes be called with args in the right order;
  28.   o  added metering support.
  29.  
  30. by Hallvard:
  31.   o  added relative jump instructions;
  32.   o  all conditionals now only do QUIT if they jump.
  33.  */
  34.  
  35. #include "config.h"
  36. #include "lisp.h"
  37. #include "buffer.h"
  38. #include "syntax.h"
  39.  
  40. #include "bytecode_p.h"
  41. #include "alloca_p.h"
  42. #include "cmds_p.h"
  43. #include "syntax_p.h"
  44.  
  45. /*
  46.  * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for 
  47.  * debugging the byte compiler...)
  48.  *
  49.  * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. 
  50.  */
  51. #define BYTE_CODE_SAFE
  52. /* #define BYTE_CODE_METER */
  53.  
  54.  
  55. #ifdef BYTE_CODE_METER
  56.  
  57. Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
  58. int byte_metering_on;
  59.  
  60. #define METER_2(code1, code2) \
  61.   XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \
  62.         ->contents[(code2)])
  63.  
  64. #define METER_1(code) METER_2 (0, (code))
  65.  
  66. #define METER_CODE(last_code, this_code)            \
  67. {                                \
  68.   if (byte_metering_on)                        \
  69.     {                                \
  70.       if (METER_1 (this_code) != ((1<<VALBITS)-1))        \
  71.         METER_1 (this_code)++;                    \
  72.       if (last_code                        \
  73.       && METER_2 (last_code, this_code) != ((1<<VALBITS)-1))\
  74.         METER_2 (last_code, this_code)++;            \
  75.     }                                \
  76. }
  77.  
  78. #else /* no BYTE_CODE_METER */
  79.  
  80. #define METER_CODE(last_code, this_code)
  81.  
  82. #endif /* no BYTE_CODE_METER */
  83.  
  84.  
  85. Lisp_Object Qbytecode;
  86.  
  87. /*  Byte codes: */
  88.  
  89. #define Bvarref 010
  90. #define Bvarset 020
  91. #define Bvarbind 030
  92. #define Bcall 040
  93. #define Bunbind 050
  94.  
  95. #define Bnth 070
  96. #define Bsymbolp 071
  97. #define Bconsp 072
  98. #define Bstringp 073
  99. #define Blistp 074
  100. #define Beq 075
  101. #define Bmemq 076
  102. #define Bnot 077
  103. #define Bcar 0100
  104. #define Bcdr 0101
  105. #define Bcons 0102
  106. #define Blist1 0103
  107. #define Blist2 0104
  108. #define Blist3 0105
  109. #define Blist4 0106
  110. #define Blength 0107
  111. #define Baref 0110
  112. #define Baset 0111
  113. #define Bsymbol_value 0112
  114. #define Bsymbol_function 0113
  115. #define Bset 0114
  116. #define Bfset 0115
  117. #define Bget 0116
  118. #define Bsubstring 0117
  119. #define Bconcat2 0120
  120. #define Bconcat3 0121
  121. #define Bconcat4 0122
  122. #define Bsub1 0123
  123. #define Badd1 0124
  124. #define Beqlsign 0125
  125. #define Bgtr 0126
  126. #define Blss 0127
  127. #define Bleq 0130
  128. #define Bgeq 0131
  129. #define Bdiff 0132
  130. #define Bnegate 0133
  131. #define Bplus 0134
  132. #define Bmax 0135
  133. #define Bmin 0136
  134. #define Bmult 0137
  135.  
  136. #define Bpoint 0140
  137. #define Bmark 0141 /* no longer generated as of v18 */
  138. #define Bgoto_char 0142
  139. #define Binsert 0143
  140. #define Bpoint_max 0144
  141. #define Bpoint_min 0145
  142. #define Bchar_after 0146
  143. #define Bfollowing_char 0147
  144. #define Bpreceding_char 0150
  145. #define Bcurrent_column 0151
  146. #define Bindent_to 0152
  147. #define Bscan_buffer 0153 /* No longer generated as of v18 */
  148. #define Beolp 0154
  149. #define Beobp 0155
  150. #define Bbolp 0156
  151. #define Bbobp 0157
  152. #define Bcurrent_buffer 0160
  153. #define Bset_buffer 0161
  154. #define Bread_char 0162 /* No longer generated as of v19 */
  155. #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
  156. #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
  157.  
  158. #define Bforward_char 0165
  159. #define Bforward_word 0166
  160. #define Bskip_chars_forward 0167
  161. #define Bskip_chars_backward 0170
  162. #define Bforward_line 0171
  163. #define Bchar_syntax 0172
  164. #define Bbuffer_substring 0173
  165. #define Bdelete_region 0174
  166. #define Bnarrow_to_region 0175
  167. #define Bwiden 0176
  168. #define Bend_of_line 0177
  169.  
  170. #define Bconstant2 0201
  171. #define Bgoto 0202
  172. #define Bgotoifnil 0203
  173. #define Bgotoifnonnil 0204
  174. #define Bgotoifnilelsepop 0205
  175. #define Bgotoifnonnilelsepop 0206
  176. #define Breturn 0207
  177. #define Bdiscard 0210
  178. #define Bdup 0211
  179.  
  180. #define Bsave_excursion 0212
  181. #define Bsave_window_excursion 0213
  182. #define Bsave_restriction 0214
  183. #define Bcatch 0215
  184.  
  185. #define Bunwind_protect 0216
  186. #define Bcondition_case 0217
  187. #define Btemp_output_buffer_setup 0220
  188. #define Btemp_output_buffer_show 0221
  189.  
  190. #define Bunbind_all 0222
  191.  
  192. #define Bset_marker 0223
  193. #define Bmatch_beginning 0224
  194. #define Bmatch_end 0225
  195. #define Bupcase 0226
  196. #define Bdowncase 0227
  197.  
  198. #define Bstringeqlsign 0230
  199. #define Bstringlss 0231
  200. #define Bequal 0232
  201. #define Bnthcdr 0233
  202. #define Belt 0234
  203. #define Bmember 0235
  204. #define Bassq 0236
  205. #define Bnreverse 0237
  206. #define Bsetcar 0240
  207. #define Bsetcdr 0241
  208. #define Bcar_safe 0242
  209. #define Bcdr_safe 0243
  210. #define Bnconc 0244
  211. #define Bquo 0245
  212. #define Brem 0246
  213. #define Bnumberp 0247
  214. #define Bintegerp 0250
  215.  
  216. #define BRgoto 0252
  217. #define BRgotoifnil 0253
  218. #define BRgotoifnonnil 0254
  219. #define BRgotoifnilelsepop 0255
  220. #define BRgotoifnonnilelsepop 0256
  221.  
  222. #define BlistN 0257
  223. #define BconcatN 0260
  224. #define BinsertN 0261
  225.  
  226. #define Bconstant 0300
  227. #define CONSTANTLIM 0100
  228.  
  229. /* Fetch the next byte from the bytecode stream */
  230.  
  231. #define FETCH *pc++
  232.  
  233. /* Fetch two bytes from the bytecode stream
  234.  and make a 16-bit number out of them */
  235.  
  236. #define FETCH2 (op = FETCH, op + (FETCH << 8))
  237.  
  238. /* Push x onto the execution stack. */
  239.  
  240. /* This used to be #define PUSH(x) (*++stackp = (x))
  241.    This oddity is necessary because Alliant can't be bothered to
  242.    compile the preincrement operator properly, as of 4/91.  -JimB  */
  243. #define PUSH(x) (stackp++, *stackp = (x))
  244.  
  245. /* Pop a value off the execution stack.  */
  246.  
  247. #define POP (*stackp--)
  248.  
  249. /* Discard n values from the execution stack.  */
  250.  
  251. #define DISCARD(n) (stackp -= (n))
  252.  
  253. /* Get the value which is at the top of the execution stack, but don't pop it. */
  254.  
  255. #define TOP (*stackp)
  256.  
  257. DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
  258.   "Function used internally in byte-compiled code.\n\
  259. The first argument is a string of byte code; the second, a vector of constants;\n\
  260. the third, the maximum stack depth used in this function.\n\
  261. If the third argument is incorrect, Emacs may crash.")
  262.   (bytestr, vector, maxdepth)
  263.      Lisp_Object bytestr, vector, maxdepth;
  264. {
  265.   struct gcpro gcpro1, gcpro2, gcpro3;
  266.   int count = specpdl_ptr - specpdl;
  267. #ifdef BYTE_CODE_METER
  268.   int this_op = 0;
  269.   int prev_op;
  270. #endif
  271.   register int op;
  272.   unsigned char *pc;
  273.   Lisp_Object *stack;
  274.   register Lisp_Object *stackp;
  275.   Lisp_Object *stacke;
  276.   register Lisp_Object v1, v2;
  277.   register Lisp_Object *vectorp = XVECTOR (vector)->contents;
  278. #ifdef BYTE_CODE_SAFE
  279.   register int const_length = XVECTOR (vector)->size;
  280. #endif
  281.   /* Copy of BYTESTR, saved so we can tell if BYTESTR was relocated.  */
  282.   Lisp_Object string_saved;
  283.  
  284.   CHECK_STRING (bytestr, 0);
  285.   if (XTYPE (vector) != Lisp_Vector)
  286.     vector = wrong_type_argument (Qvectorp, vector);
  287.   CHECK_NUMBER (maxdepth, 2);
  288.  
  289.   stackp = (Lisp_Object *) alloca (XFASTINT (maxdepth) * sizeof (Lisp_Object));
  290.   bzero (stackp, XFASTINT (maxdepth) * sizeof (Lisp_Object));
  291.   GCPRO3 (bytestr, vector, *stackp);
  292.   gcpro3.nvars = XFASTINT (maxdepth);
  293.  
  294.   --stackp;
  295.   stack = stackp;
  296.   stacke = stackp + XFASTINT (maxdepth);
  297.  
  298.   /* Initialize the saved pc-pointer for fetching from the string.  */
  299.   string_saved = bytestr;
  300.   pc = XSTRING (string_saved)->data;
  301.  
  302.   while (1)
  303.     {
  304. #ifdef BYTE_CODE_SAFE
  305.       if (stackp > stacke)
  306.     error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d",
  307.            pc - XSTRING (string_saved)->data, stacke - stackp);
  308.       if (stackp < stack)
  309.     error ("Byte code stack underflow (byte compiler bug), pc %d",
  310.            pc - XSTRING (string_saved)->data);
  311. #endif
  312.  
  313.       if (! EQ (string_saved, bytestr))
  314.     {
  315.       pc = pc - XSTRING (string_saved)->data + XSTRING (bytestr)->data;
  316.       string_saved = bytestr;
  317.     }
  318.  
  319. #ifdef BYTE_CODE_METER
  320.       prev_op = this_op;
  321.       this_op = op = FETCH;
  322.       METER_CODE (prev_op, op);
  323.       switch (op)
  324. #else
  325.       switch (op = FETCH)
  326. #endif
  327.     {
  328.     case Bvarref+6:
  329.       op = FETCH;
  330.       goto varref;
  331.  
  332.     case Bvarref+7:
  333.       op = FETCH2;
  334.       goto varref;
  335.  
  336.     case Bvarref: case Bvarref+1: case Bvarref+2: case Bvarref+3:
  337.     case Bvarref+4: case Bvarref+5:
  338.       op = op - Bvarref;
  339.     varref:
  340.       v1 = vectorp[op];
  341.       if (XTYPE (v1) != Lisp_Symbol)
  342.         v2 = Fsymbol_value (v1);
  343.       else
  344.         {
  345.           v2 = XSYMBOL (v1)->value;
  346. #ifdef SWITCH_ENUM_BUG
  347.           switch ((int) XTYPE (v2))
  348. #else
  349.           switch (XTYPE (v2))
  350. #endif
  351.         {
  352.         case Lisp_Symbol:
  353.           if (!EQ (v2, Qunbound))
  354.             break;
  355.         case Lisp_Intfwd:
  356.         case Lisp_Boolfwd:
  357.         case Lisp_Objfwd:
  358.         case Lisp_Buffer_Local_Value:
  359.         case Lisp_Some_Buffer_Local_Value:
  360.         case Lisp_Buffer_Objfwd:
  361.         case Lisp_Void:
  362.           v2 = Fsymbol_value (v1);
  363.         }
  364.         }
  365.       PUSH (v2);
  366.       break;
  367.  
  368.     case Bvarset+6:
  369.       op = FETCH;
  370.       goto varset;
  371.  
  372.     case Bvarset+7:
  373.       op = FETCH2;
  374.       goto varset;
  375.  
  376.     case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3:
  377.     case Bvarset+4: case Bvarset+5:
  378.       op -= Bvarset;
  379.     varset:
  380.       Fset (vectorp[op], POP);
  381.       break;
  382.  
  383.     case Bvarbind+6:
  384.       op = FETCH;
  385.       goto varbind;
  386.  
  387.     case Bvarbind+7:
  388.       op = FETCH2;
  389.       goto varbind;
  390.  
  391.     case Bvarbind: case Bvarbind+1: case Bvarbind+2: case Bvarbind+3:
  392.     case Bvarbind+4: case Bvarbind+5:
  393.       op -= Bvarbind;
  394.     varbind:
  395.       specbind (vectorp[op], POP);
  396.       break;
  397.  
  398.     case Bcall+6:
  399.       op = FETCH;
  400.       goto docall;
  401.  
  402.     case Bcall+7:
  403.       op = FETCH2;
  404.       goto docall;
  405.  
  406.     case Bcall: case Bcall+1: case Bcall+2: case Bcall+3:
  407.     case Bcall+4: case Bcall+5:
  408.       op -= Bcall;
  409.     docall:
  410.       DISCARD (op);
  411. #ifdef BYTE_CODE_METER
  412.       if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol)
  413.         {
  414.           v1 = TOP;
  415.           v2 = Fget (v1, Qbyte_code_meter);
  416.           if (XTYPE (v2) == Lisp_Int
  417.           && XINT (v2) != ((1<<VALBITS)-1))
  418.         {
  419.           XSETINT (v2, XINT (v2) + 1);
  420.           Fput (v1, Qbyte_code_meter, v2);
  421.         }
  422.         }
  423. #endif
  424.       TOP = Ffuncall (op + 1, &TOP);
  425.       break;
  426.  
  427.     case Bunbind+6:
  428.       op = FETCH;
  429.       goto dounbind;
  430.  
  431.     case Bunbind+7:
  432.       op = FETCH2;
  433.       goto dounbind;
  434.  
  435.     case Bunbind: case Bunbind+1: case Bunbind+2: case Bunbind+3:
  436.     case Bunbind+4: case Bunbind+5:
  437.       op -= Bunbind;
  438.     dounbind:
  439.       unbind_to (specpdl_ptr - specpdl - op, Qnil);
  440.       break;
  441.  
  442.     case Bunbind_all:
  443.       /* To unbind back to the beginning of this frame.  Not used yet,
  444.          but will be needed for tail-recursion elimination.  */
  445.       unbind_to (count, Qnil);
  446.       break;
  447.  
  448.     case Bgoto:
  449.       QUIT;
  450.       op = FETCH2;    /* pc = FETCH2 loses since FETCH2 contains pc++ */
  451.       pc = XSTRING (string_saved)->data + op;
  452.       break;
  453.  
  454.     case Bgotoifnil:
  455.       op = FETCH2;
  456.       if (NILP (POP))
  457.         {
  458.           QUIT;
  459.           pc = XSTRING (string_saved)->data + op;
  460.         }
  461.       break;
  462.  
  463.     case Bgotoifnonnil:
  464.       op = FETCH2;
  465.       if (!NILP (POP))
  466.         {
  467.           QUIT;
  468.           pc = XSTRING (string_saved)->data + op;
  469.         }
  470.       break;
  471.  
  472.     case Bgotoifnilelsepop:
  473.       op = FETCH2;
  474.       if (NILP (TOP))
  475.         {
  476.           QUIT;
  477.           pc = XSTRING (string_saved)->data + op;
  478.         }
  479.       else DISCARD (1);
  480.       break;
  481.  
  482.     case Bgotoifnonnilelsepop:
  483.       op = FETCH2;
  484.       if (!NILP (TOP))
  485.         {
  486.           QUIT;
  487.           pc = XSTRING (string_saved)->data + op;
  488.         }
  489.       else DISCARD (1);
  490.       break;
  491.  
  492.     case BRgoto:
  493.       QUIT;
  494.       pc += *pc - 127;
  495.       break;
  496.  
  497.     case BRgotoifnil:
  498.       if (NILP (POP))
  499.         {
  500.           QUIT;
  501.           pc += *pc - 128;
  502.         }
  503.       pc++;
  504.       break;
  505.  
  506.     case BRgotoifnonnil:
  507.       if (!NILP (POP))
  508.         {
  509.           QUIT;
  510.           pc += *pc - 128;
  511.         }
  512.       pc++;
  513.       break;
  514.  
  515.     case BRgotoifnilelsepop:
  516.       op = *pc++;
  517.       if (NILP (TOP))
  518.         {
  519.           QUIT;
  520.           pc += op - 128;
  521.         }
  522.       else DISCARD (1);
  523.       break;
  524.  
  525.     case BRgotoifnonnilelsepop:
  526.       op = *pc++;
  527.       if (!NILP (TOP))
  528.         {
  529.           QUIT;
  530.           pc += op - 128;
  531.         }
  532.       else DISCARD (1);
  533.       break;
  534.  
  535.     case Breturn:
  536.       v1 = POP;
  537.       goto exit;
  538.  
  539.     case Bdiscard:
  540.       DISCARD (1);
  541.       break;
  542.  
  543.     case Bdup:
  544.       v1 = TOP;
  545.       PUSH (v1);
  546.       break;
  547.  
  548.     case Bconstant2:
  549.       PUSH (vectorp[FETCH2]);
  550.       break;
  551.  
  552.     case Bsave_excursion:
  553.       record_unwind_protect (save_excursion_restore, save_excursion_save ());
  554.       break;
  555.  
  556.     case Bsave_window_excursion:
  557.       TOP = Fsave_window_excursion (TOP);
  558.       break;
  559.  
  560.     case Bsave_restriction:
  561.       record_unwind_protect (save_restriction_restore, save_restriction_save ());
  562.       break;
  563.  
  564.     case Bcatch:
  565.       v1 = POP;
  566.       TOP = internal_catch (TOP, Feval, v1);
  567.       break;
  568.  
  569.     case Bunwind_protect:
  570.       record_unwind_protect (0, POP);
  571.       (specpdl_ptr - 1)->symbol = Qnil;
  572.       break;
  573.  
  574.     case Bcondition_case:
  575.       v1 = POP;
  576.       v1 = Fcons (POP, v1);
  577.       TOP = Fcondition_case (Fcons (TOP, v1));
  578.       break;
  579.  
  580.     case Btemp_output_buffer_setup:
  581.       temp_output_buffer_setup (XSTRING (TOP)->data);
  582.       TOP = Vstandard_output;
  583.       break;
  584.  
  585.     case Btemp_output_buffer_show:
  586.       v1 = POP;
  587.       temp_output_buffer_show (TOP);
  588.       TOP = v1;
  589.       /* pop binding of standard-output */
  590.       unbind_to (specpdl_ptr - specpdl - 1, Qnil);
  591.       break;
  592.  
  593.     case Bnth:
  594.       v1 = POP;
  595.       v2 = TOP;
  596.     nth_entry:
  597.       CHECK_NUMBER (v2, 0);
  598.       op = XINT (v2);
  599.       immediate_quit = 1;
  600.       while (--op >= 0)
  601.         {
  602.           if (CONSP (v1))
  603.         v1 = XCONS (v1)->cdr;
  604.           else if (!NILP (v1))
  605.         {
  606.           immediate_quit = 0;
  607.           v1 = wrong_type_argument (Qlistp, v1);
  608.           immediate_quit = 1;
  609.           op++;
  610.         }
  611.         }
  612.       immediate_quit = 0;
  613.       goto docar;
  614.  
  615.     case Bsymbolp:
  616.       TOP = XTYPE (TOP) == Lisp_Symbol ? Qt : Qnil;
  617.       break;
  618.  
  619.     case Bconsp:
  620.       TOP = CONSP (TOP) ? Qt : Qnil;
  621.       break;
  622.  
  623.     case Bstringp:
  624.       TOP = XTYPE (TOP) == Lisp_String ? Qt : Qnil;
  625.       break;
  626.  
  627.     case Blistp:
  628.       TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
  629.       break;
  630.  
  631.     case Beq:
  632.       v1 = POP;
  633.       TOP = EQ (v1, TOP) ? Qt : Qnil;
  634.       break;
  635.  
  636.     case Bmemq:
  637.       v1 = POP;
  638.       TOP = Fmemq (TOP, v1);
  639.       break;
  640.  
  641.     case Bnot:
  642.       TOP = NILP (TOP) ? Qt : Qnil;
  643.       break;
  644.  
  645.     case Bcar:
  646.       v1 = TOP;
  647.     docar:
  648.       if (CONSP (v1)) TOP = XCONS (v1)->car;
  649.       else if (NILP (v1)) TOP = Qnil;
  650.       else Fcar (wrong_type_argument (Qlistp, v1));
  651.       break;
  652.  
  653.     case Bcdr:
  654.       v1 = TOP;
  655.       if (CONSP (v1)) TOP = XCONS (v1)->cdr;
  656.       else if (NILP (v1)) TOP = Qnil;
  657.       else Fcdr (wrong_type_argument (Qlistp, v1));
  658.       break;
  659.  
  660.     case Bcons:
  661.       v1 = POP;
  662.       TOP = Fcons (TOP, v1);
  663.       break;
  664.  
  665.     case Blist1:
  666.       TOP = Fcons (TOP, Qnil);
  667.       break;
  668.  
  669.     case Blist2:
  670.       v1 = POP;
  671.       TOP = Fcons (TOP, Fcons (v1, Qnil));
  672.       break;
  673.  
  674.     case Blist3:
  675.       DISCARD (2);
  676.       TOP = Flist (3, &TOP);
  677.       break;
  678.  
  679.     case Blist4:
  680.       DISCARD (3);
  681.       TOP = Flist (4, &TOP);
  682.       break;
  683.  
  684.     case BlistN:
  685.       op = FETCH;
  686.       DISCARD (op - 1);
  687.       TOP = Flist (op, &TOP);
  688.       break;
  689.  
  690.     case Blength:
  691.       TOP = Flength (TOP);
  692.       break;
  693.  
  694.     case Baref:
  695.           v1 = POP;
  696.       TOP = Faref (TOP, v1);
  697.       break;
  698.  
  699.     case Baset:
  700.       v2 = POP; v1 = POP;
  701.       TOP = Faset (TOP, v1, v2);
  702.       break;
  703.  
  704.     case Bsymbol_value:
  705.       TOP = Fsymbol_value (TOP);
  706.       break;
  707.  
  708.     case Bsymbol_function:
  709.       TOP = Fsymbol_function (TOP);
  710.       break;
  711.  
  712.     case Bset:
  713.       v1 = POP;
  714.       TOP = Fset (TOP, v1);
  715.       break;
  716.  
  717.     case Bfset:
  718.       v1 = POP;
  719.       TOP = Ffset (TOP, v1);
  720.       break;
  721.  
  722.     case Bget:
  723.       v1 = POP;
  724.       TOP = Fget (TOP, v1);
  725.       break;
  726.  
  727.     case Bsubstring:
  728.       v2 = POP; v1 = POP;
  729.       TOP = Fsubstring (TOP, v1, v2);
  730.       break;
  731.  
  732.     case Bconcat2:
  733.       DISCARD (1);
  734.       TOP = Fconcat (2, &TOP);
  735.       break;
  736.  
  737.     case Bconcat3:
  738.       DISCARD (2);
  739.       TOP = Fconcat (3, &TOP);
  740.       break;
  741.  
  742.     case Bconcat4:
  743.       DISCARD (3);
  744.       TOP = Fconcat (4, &TOP);
  745.       break;
  746.  
  747.     case BconcatN:
  748.       op = FETCH;
  749.       DISCARD (op - 1);
  750.       TOP = Fconcat (op, &TOP);
  751.       break;
  752.  
  753.     case Bsub1:
  754.       v1 = TOP;
  755.       if (XTYPE (v1) == Lisp_Int)
  756.         {
  757.           XSETINT (v1, XINT (v1) - 1);
  758.           TOP = v1;
  759.         }
  760.       else
  761.         TOP = Fsub1 (v1);
  762.       break;
  763.  
  764.     case Badd1:
  765.       v1 = TOP;
  766.       if (XTYPE (v1) == Lisp_Int)
  767.         {
  768.           XSETINT (v1, XINT (v1) + 1);
  769.           TOP = v1;
  770.         }
  771.       else
  772.         TOP = Fadd1 (v1);
  773.       break;
  774.  
  775.     case Beqlsign:
  776.       v2 = POP; v1 = TOP;
  777.       CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0);
  778.       CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0);
  779.       TOP = (XFLOATINT (v1) == XFLOATINT (v2)) ? Qt : Qnil;
  780.       break;
  781.  
  782.     case Bgtr:
  783.       v1 = POP;
  784.       TOP = Fgtr (TOP, v1);
  785.       break;
  786.  
  787.     case Blss:
  788.       v1 = POP;
  789.       TOP = Flss (TOP, v1);
  790.       break;
  791.  
  792.     case Bleq:
  793.       v1 = POP;
  794.       TOP = Fleq (TOP, v1);
  795.       break;
  796.  
  797.     case Bgeq:
  798.       v1 = POP;
  799.       TOP = Fgeq (TOP, v1);
  800.       break;
  801.  
  802.     case Bdiff:
  803.       DISCARD (1);
  804.       TOP = Fminus (2, &TOP);
  805.       break;
  806.  
  807.     case Bnegate:
  808.       v1 = TOP;
  809.       if (XTYPE (v1) == Lisp_Int)
  810.         {
  811.           XSETINT (v1, - XINT (v1));
  812.           TOP = v1;
  813.         }
  814.       else
  815.         TOP = Fminus (1, &TOP);
  816.       break;
  817.  
  818.     case Bplus:
  819.       DISCARD (1);
  820.       TOP = Fplus (2, &TOP);
  821.       break;
  822.  
  823.     case Bmax:
  824.       DISCARD (1);
  825.       TOP = Fmax (2, &TOP);
  826.       break;
  827.  
  828.     case Bmin:
  829.       DISCARD (1);
  830.       TOP = Fmin (2, &TOP);
  831.       break;
  832.  
  833.     case Bmult:
  834.       DISCARD (1);
  835.       TOP = Ftimes (2, &TOP);
  836.       break;
  837.  
  838.     case Bquo:
  839.       DISCARD (1);
  840.       TOP = Fquo (2, &TOP);
  841.       break;
  842.  
  843.     case Brem:
  844.       v1 = POP;
  845.       TOP = Frem (TOP, v1);
  846.       break;
  847.  
  848.     case Bpoint:
  849.       XFASTINT (v1) = point;
  850.       PUSH (v1);
  851.       break;
  852.  
  853.     case Bgoto_char:
  854.       TOP = Fgoto_char (TOP);
  855.       break;
  856.  
  857.     case Binsert:
  858.       TOP = Finsert (1, &TOP);
  859.       break;
  860.  
  861.     case BinsertN:
  862.       op = FETCH;
  863.       DISCARD (op - 1);
  864.       TOP = Finsert (op, &TOP);
  865.       break;
  866.  
  867.     case Bpoint_max:
  868.       XFASTINT (v1) = ZV;
  869.       PUSH (v1);
  870.       break;
  871.  
  872.     case Bpoint_min:
  873.       XFASTINT (v1) = BEGV;
  874.       PUSH (v1);
  875.       break;
  876.  
  877.     case Bchar_after:
  878.       TOP = Fchar_after (TOP);
  879.       break;
  880.  
  881.     case Bfollowing_char:
  882.       XFASTINT (v1) = PT == ZV ? 0 : FETCH_CHAR (point);
  883.       PUSH (v1);
  884.       break;
  885.  
  886.     case Bpreceding_char:
  887.       XFASTINT (v1) = point <= BEGV ? 0 : FETCH_CHAR (point - 1);
  888.       PUSH (v1);
  889.       break;
  890.  
  891.     case Bcurrent_column:
  892.       XFASTINT (v1) = current_column ();
  893.       PUSH (v1);
  894.       break;
  895.  
  896.     case Bindent_to:
  897.       TOP = Findent_to (TOP, Qnil);
  898.       break;
  899.  
  900.     case Beolp:
  901.       PUSH (Feolp ());
  902.       break;
  903.  
  904.     case Beobp:
  905.       PUSH (Feobp ());
  906.       break;
  907.  
  908.     case Bbolp:
  909.       PUSH (Fbolp ());
  910.       break;
  911.  
  912.     case Bbobp:
  913.       PUSH (Fbobp ());
  914.       break;
  915.  
  916.     case Bcurrent_buffer:
  917.       PUSH (Fcurrent_buffer ());
  918.       break;
  919.  
  920.     case Bset_buffer:
  921.       TOP = Fset_buffer (TOP);
  922.       break;
  923.  
  924.     case Bread_char:
  925.       PUSH (Fread_char ());
  926.       QUIT;
  927.       break;
  928.  
  929.     case Binteractive_p:
  930.       PUSH (Finteractive_p ());
  931.       break;
  932.  
  933.     case Bforward_char:
  934.       TOP = Fforward_char (TOP);
  935.       break;
  936.  
  937.     case Bforward_word:
  938.       TOP = Fforward_word (TOP);
  939.       break;
  940.  
  941.     case Bskip_chars_forward:
  942.       v1 = POP;
  943.       TOP = Fskip_chars_forward (TOP, v1);
  944.       break;
  945.  
  946.     case Bskip_chars_backward:
  947.       v1 = POP;
  948.       TOP = Fskip_chars_backward (TOP, v1);
  949.       break;
  950.  
  951.     case Bforward_line:
  952.       TOP = Fforward_line (TOP);
  953.       break;
  954.  
  955.     case Bchar_syntax:
  956.       CHECK_NUMBER (TOP, 0);
  957.       XFASTINT (TOP) = syntax_code_spec[(int) SYNTAX (0xFF & XINT (TOP))];
  958.       break;
  959.  
  960.     case Bbuffer_substring:
  961.       v1 = POP;
  962.       TOP = Fbuffer_substring (TOP, v1);
  963.       break;
  964.  
  965.     case Bdelete_region:
  966.       v1 = POP;
  967.       TOP = Fdelete_region (TOP, v1);
  968.       break;
  969.  
  970.     case Bnarrow_to_region:
  971.       v1 = POP;
  972.       TOP = Fnarrow_to_region (TOP, v1);
  973.       break;
  974.  
  975.     case Bwiden:
  976.       PUSH (Fwiden ());
  977.       break;
  978.  
  979.     case Bend_of_line:
  980.       TOP = Fend_of_line (TOP);
  981.       break;
  982.  
  983.     case Bset_marker:
  984.       v1 = POP;
  985.       v2 = POP;
  986.       TOP = Fset_marker (TOP, v2, v1);
  987.       break;
  988.  
  989.     case Bmatch_beginning:
  990.       TOP = Fmatch_beginning (TOP);
  991.       break;
  992.  
  993.     case Bmatch_end:
  994.       TOP = Fmatch_end (TOP);
  995.       break;
  996.  
  997.     case Bupcase:
  998.       TOP = Fupcase (TOP);
  999.       break;
  1000.  
  1001.     case Bdowncase:
  1002.       TOP = Fdowncase (TOP);
  1003.     break;
  1004.  
  1005.     case Bstringeqlsign:
  1006.       v1 = POP;
  1007.       TOP = Fstring_equal (TOP, v1);
  1008.       break;
  1009.  
  1010.     case Bstringlss:
  1011.       v1 = POP;
  1012.       TOP = Fstring_lessp (TOP, v1);
  1013.       break;
  1014.  
  1015.     case Bequal:
  1016.       v1 = POP;
  1017.       TOP = Fequal (TOP, v1);
  1018.       break;
  1019.  
  1020.     case Bnthcdr:
  1021.       v1 = POP;
  1022.       TOP = Fnthcdr (TOP, v1);
  1023.       break;
  1024.  
  1025.     case Belt:
  1026.       if (XTYPE (TOP) == Lisp_Cons)
  1027.         {
  1028.           /* Exchange args and then do nth.  */
  1029.           v2 = POP;
  1030.           v1 = TOP;
  1031.           goto nth_entry;
  1032.         }
  1033.       v1 = POP;
  1034.       TOP = Felt (TOP, v1);
  1035.       break;
  1036.  
  1037.     case Bmember:
  1038.       v1 = POP;
  1039.       TOP = Fmember (TOP, v1);
  1040.       break;
  1041.  
  1042.     case Bassq:
  1043.       v1 = POP;
  1044.       TOP = Fassq (TOP, v1);
  1045.       break;
  1046.  
  1047.     case Bnreverse:
  1048.       TOP = Fnreverse (TOP);
  1049.       break;
  1050.  
  1051.     case Bsetcar:
  1052.       v1 = POP;
  1053.       TOP = Fsetcar (TOP, v1);
  1054.       break;
  1055.  
  1056.     case Bsetcdr:
  1057.       v1 = POP;
  1058.       TOP = Fsetcdr (TOP, v1);
  1059.       break;
  1060.  
  1061.     case Bcar_safe:
  1062.       v1 = TOP;
  1063.       if (XTYPE (v1) == Lisp_Cons)
  1064.         TOP = XCONS (v1)->car;
  1065.       else
  1066.         TOP = Qnil;
  1067.       break;
  1068.  
  1069.     case Bcdr_safe:
  1070.       v1 = TOP;
  1071.       if (XTYPE (v1) == Lisp_Cons)
  1072.         TOP = XCONS (v1)->cdr;
  1073.       else
  1074.         TOP = Qnil;
  1075.       break;
  1076.  
  1077.     case Bnconc:
  1078.       DISCARD (1);
  1079.       TOP = Fnconc (2, &TOP);
  1080.       break;
  1081.  
  1082.     case Bnumberp:
  1083.       TOP = (NUMBERP (TOP) ? Qt : Qnil);
  1084.       break;
  1085.  
  1086.     case Bintegerp:
  1087.       TOP = XTYPE (TOP) == Lisp_Int ? Qt : Qnil;
  1088.       break;
  1089.  
  1090. #ifdef BYTE_CODE_SAFE
  1091.     case Bset_mark:
  1092.       error ("set-mark is an obsolete bytecode");
  1093.       break;
  1094.     case Bscan_buffer:
  1095.       error ("scan-buffer is an obsolete bytecode");
  1096.       break;
  1097.     case Bmark:
  1098.       error ("mark is an obsolete bytecode");
  1099.       break;
  1100. #endif
  1101.  
  1102.     default:
  1103. #ifdef BYTE_CODE_SAFE
  1104.       if (op < Bconstant)
  1105.         error ("unknown bytecode %d (byte compiler bug)", op);
  1106.       if ((op -= Bconstant) >= const_length)
  1107.         error ("no constant number %d (byte compiler bug)", op);
  1108.       PUSH (vectorp[op]);
  1109. #else
  1110.       PUSH (vectorp[op - Bconstant]);
  1111. #endif
  1112.     }
  1113.     }
  1114.  
  1115.  exit:
  1116.   UNGCPRO;
  1117.   /* Binds and unbinds are supposed to be compiled balanced.  */
  1118.   if (specpdl_ptr - specpdl != count)
  1119. #ifdef BYTE_CODE_SAFE
  1120.     error ("binding stack not balanced (serious byte compiler bug)");
  1121. #else
  1122.     abort ();
  1123. #endif
  1124.   return v1;
  1125. }
  1126.  
  1127. _VOID_
  1128. syms_of_bytecode ()
  1129. {
  1130.   Qbytecode = intern ("byte-code");
  1131.   staticpro (&Qbytecode);
  1132.  
  1133.   defsubr (&Sbyte_code);
  1134.  
  1135. #ifdef BYTE_CODE_METER
  1136.  
  1137.   DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
  1138.    "A vector of vectors which holds a histogram of byte-code usage.\n\
  1139. (aref (aref byte-code-meter 0) CODE) indicates how many times the byte\n\
  1140. opcode CODE has been executed.\n\
  1141. (aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,\n\
  1142. indicates how many times the byte opcodes CODE1 and CODE2 have been\n\
  1143. executed in succession.");
  1144.   DEFVAR_BOOL ("byte-metering-on", &byte_metering_on,
  1145.    "If non-nil, keep profiling information on byte code usage.\n\
  1146. The variable byte-code-meter indicates how often each byte opcode is used.\n\
  1147. If a symbol has a property named `byte-code-meter' whose value is an\n\
  1148. integer, it is incremented each time that symbol's function is called.");
  1149.  
  1150.   byte_metering_on = 0;
  1151.   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
  1152.   Qbyte_code_meter = intern ("byte-code-meter");
  1153.   staticpro (&Qbyte_code_meter);
  1154.   {
  1155.     int i = 256;
  1156.     while (i--)
  1157.       XVECTOR (Vbyte_code_meter)->contents[i] =
  1158.     Fmake_vector (make_number (256), make_number (0));
  1159.   }
  1160. #endif
  1161. }
  1162.